'Classic sliding block puzzle.bas 2015-12-04 SmallBASIC 0.12.1 [B+=MGA]
' modified from  Sliding Blocks Puzzle Game programmed by Hermang H. M. M. 
' copied from BP.org 2015-07-05 in YABasic.
' updated to work in an Android NOOK from On-line samples 

if xmax> ymax then ssq=ymax else ssq=xmax
MaxSize = 10
th=txth("By")+4   'text height
label start
myline=0
color 0,11:cls 'sets all print fore and back color, squares have to match
at 0,th*1:? "           SLIDING BLOCKS PUZZLE"
for i=3 to MaxSize
  at 0,th*i:? "Tap/click this line for board size ";i;"x";i
next
at 0,th*(MaxSize+1):? "Tap/click this line to quit"
pen on
repeat
  if pen(3) then myline=int(pen(5)/th): delay 60
until myline> 2 and myline< MaxSize+2
pen off
if myline=MaxSize+1 then cls:end else size=myline

'============================================ and we are off to play a game
dim board(size+1,size+1)
tlx=40   'top left x for board
tly=3*th 'top left y for board
sq=int((ssq-4*th)/size)  'board sq size
cls 
rect 0,0,2*tlx+sq*size,ssq,9 filled 'set board on blue left side
for i=0 to 3
   rect 0,0,2*tlx+sq*size-i,ssq-i,0
next
initBoard()
mixBlocks()
showBoard()
s=" SLIDING BLOCKS PUZZLE: r resets, q quits "
at (ssq-txtw(s))/2,0*th+2:? s
s=" tap block or arrow key to move block "
at (ssq-txtw(s))/2,1*th+2:? s 
pen on
repeat
   if pen(3) then
      mx=bx(pen(4))
      my=by(pen(5))
      if emptyRow+1=mx and emptyCol=my then doleft
      if emptyRow-1=mx and emptyCol=my then doright
      if emptyRow=mx and emptyCol+1=my then doup
      if emptyRow=mx and emptyCol-1=my then dodown
   endif
   k=inkey
   if len(k)=2 then
      ak=asc(right(k,1))
      if ak=4 then:doleft
      elseif ak=5:doright
      elseif ak=9:doup
      elseif ak=10:dodown:endif
   elseif len(k)=1
      if k="r" then mixBlocks
   endif   
   if update=1 then showBoard
   if TFsolved then k="q"
until(k="q")
pen off
if TFsolved then 
  for i=1 to 20
    if i mod 2 then 
      s=" Congratulations, Puzzle Solved! "
    else
      s=space(32)
    end if
    at (ssq-txtw(s))/2,2*th+2:? s
    delay 200
  next  
  goto start
end if

'==========procedures

sub initBoard()
   count=0
   for j=0 to size+1
      for i=0 to size+1
         if i=0 or j=0 or i=(size+1) or j=(size+1) then
            board(i,j)=-1
         else
            count=count+1
            board(i,j)=count
         endif
      next
   next
   board(size,size)=0
   emptyRow=size
   emptyCol=size
end

sub showBoard()
   local x,y,c
   rect tlx-1,tly-1,tlx+sq*size+2,tly+sq*size+2,0 filled
   for y=1 to size
      for x=1 to size
         if board(x,y) then c=11 else c=0
         rect tlx+sq*(x-1),tly+sq*(y-1),tlx+sq*(x-1)+sq-2,tly+sq*(y-1)+sq-2,c filled
         if board(x,y) then 
            s=str$(board(x,y))
            at tlx+sq*(x-1)+sq/2-txtw(s)/2,tly+sq*(y-1)+sq/2-txth(s)/2
            print s;
         endif
      next
   next
   update=0
end

sub mixBlocks()
   repeat
      for i=1 to 7*size*size
         dir=1+int(rnd*4)
         if dir=1 then:doleft
         elseif dir=2:doright
         elseif dir=3:doup
         else:dodown:endif
      next
   until TFsolved=0
   update=1
end

sub swapp()
   board(emptyRow,emptyCol)=tag
   board(tr,tc)=0
   emptyRow=tr
   emptyCol=tc
   update=1
end

sub doleft()
   tr=emptyRow+1
   tc=emptyCol
   tag=board(tr,tc)
   if tag=-1 then exit
   swapp
end

sub doright()
   tr=emptyRow-1
   tc=emptyCol
   tag=board(tr,tc)
   if tag=-1 then exit
   swapp
end

sub dodown()
   tr = emptyRow
   tc = emptyCol-1
   tag = board(tr,tc)
   if tag=-1 then exit
   swapp
end

sub doup()
   tr=emptyRow
   tc=emptyCol+1
   tag=board(tr,tc) 
   if tag=-1 then exit
   swapp
end

func TFsolved()
   TFsolved=0:test=1
   for j=1 to size
      for i=1 to size 
         if board(i,j)<> 0 then
            if test=board(i,j) then test=test+1 else exit sub
         endif   
      next
   next
   TFsolved=1
end

func bx(mx)
   rtn=int((mx-tlx)/sq+1)
   if rtn< size+1 and rtn> 0 then bx=rtn else bx=0
end

func by(my)
   rtn=int((my-tly)/sq+1)
   if rtn< size+1 and rtn> 0 then by=rtn else by=0
end